home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
brush
/
brush.bas
next >
Wrap
BASIC Source File
|
1995-05-09
|
2KB
|
68 lines
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'
' PatternBrush (FreeWare)
'
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
' written by dirk hilger
' for bytes & letters
' germany
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Option Explicit
Declare Function rectangle% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
Declare Function getDC% Lib "User" (ByVal hWnd%)
Declare Function releaseDC% Lib "User" (ByVal hWnd%, ByVal hDC%)
Declare Function selectobject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
Declare Function createPatternBrush% Lib "GDI" (ByVal hBitmap%)
Declare Function createPen% Lib "GDI" (ByVal nPenStyle%, ByVal nWidth%, ByVal crColor&)
Declare Function deleteobject% Lib "GDI" (ByVal hObject%)
Sub brush_control (c As Control, ByVal hBMP%, ByVal borderwidth%)
Dim os%, w%, h%, x%, y%, tf%
Dim hDC%, hWnd%
hWnd = c.hWnd
hDC = getDC(hWnd)
os = c.Parent.ScaleMode
c.Parent.ScaleMode = 3
x = borderwidth + c.Left
y = borderwidth + c.Top
w = c.Width + 1 - borderwidth
h = c.Height + 1 - borderwidth
showbrush hDC, hBMP, x, y, w, h
c.Parent.ScaleMode = os
tf = releaseDC(hWnd, hDC)
End Sub
Sub brush_form (f As Form, ByVal hBMP%)
Dim os%, w%, h%
os = f.ScaleMode
f.ScaleMode = 3
w = f.ScaleWidth + 1
h = f.ScaleHeight + 1
showbrush f.hDC, hBMP%, 0, 0, w, h
f.ScaleMode = os
End Sub
Sub form_center (f As Form)
On Local Error Resume Next
f.Left = (screen.Width - f.Width) \ 2
f.Top = (screen.Height - f.Height) \ 2
End Sub
Private Sub showbrush (ByVal hDC%, ByVal hBMP%, ByVal x%, ByVal y%, ByVal w%, ByVal h%)
Dim hbrold%, hbr%, tf%, hpen%, hpenold%
If hBMP = False Then Exit Sub
hbr = createPatternBrush(hBMP%)
hpen = createPen(5, 1, 0)
hbrold = selectobject(hDC, hbr)
hpenold = selectobject(hDC, hpen)
tf = rectangle(hDC, x, y, w, h)
hbr = selectobject(hDC, hbrold)
hpen = selectobject(hDC, hpenold)
tf = deleteobject(hbr)
tf = deleteobject(hpen)
End Sub